Internet Info 1994 March

home *** CD-ROM | disk | FTP | other *** search

/ Internet Info 1994 March / Internet Info CD-ROM (Walnut Creek) (March 1994).iso / networking / terms / kermit / b / k11rtu.mac < prev next >

Wrap

Text File | 1989-06-12 | 12.6 KB | 496 lines

.title K11RTU copy,rename and delete for RT11, no wildcarding .ident /2.20/ ; Copyright (C) 1984 Change Software, Inc. ; ; 18-Jul-84 16:14:46 Brian Nelson ; ; If wildcarding is added, this MUST be moved from ; the overlay it's in into the root. .mcall .csispc ,.delete,.dstat ,.fetch ,.rename .if ndf, K11INC .ift .include /IN:K11MAC.MAC/ .endc .enabl gbl .psect $code .save .psect rendat ,rw,d,lcl,rel,con defext: .word 0,0,0,0,0 renlst: .blkw 12 rtdsta: .blkw 5 .restore topmem = 50 errbyt = 52 star = 132500 .sbttl the real work of rename ; input: @r5 first filename, .asciz ; 2(r5) second filename, .asciz ; 4(r5) if ge 0, print a log of files renamed rename::save <r2,r3,r4> ; save these please clr r4 ; no files renamed as of yet mov #renlst ,r3 ; where to build the .rename list mov @r5 ,r0 ; string address call docsi ; do the first one bcs 100$ ; oops mov 2(r5) ,r0 ; now do the second filename call docsi ; ok bcs 100$ ; oops mov #renlst ,r1 ; check for wildcarding mov @r1 ,10(r1) ; first, force same device name mov #4*2 ,r2 ; eight words to check for wildcards 10$: cmp (r1)+ ,#star ; a wildcard today ? beq 80$ ; yes, die sob r2 ,10$ ; no, check the next one please mov renlst ,r0 ; get the device name call devload ; get device loaded if need be bcs 100$ ; it did not work .rename #rtwork,#lun.in,#renlst ; do the rename please bcs 90$ ; oops call 200$ ; log it please mov #1 ,r4 ; one file renamed clr r0 ; no errors br 100$ ; and exit 80$: mov #er$wld ,r0 ; no wildcarding today br 100$ ; exit 90$: movb @#errbyt,r0 ; map the .rename error asl r0 ; times 2 as always mov renerr(r0),r0 ; simple 100$: mov r4 ,r1 ; return rename count beq 120$ ; never got any files, exit cmp r0 ,#er$nmf ; no more files error? beq 110$ ; yes, say no errors cmp r0 ,#er$fnf ; same goes for file not found bne 120$ ; exit 110$: clr r0 ; no errors 120$: unsave <r4,r3,r2> ; pop these and exit return .sbttl log for the rt11 rename command 200$: tst 4(r5) ; print a log of this out bmi 210$ ; nothing to do print @r5 ; no wildcarding simplifies things print #290$ ; more print 2(r5) ; next print #295$ ; 210$: return 290$: .asciz / renamed to / 295$: .byte cr,lf,0 .even .sbttl the real work of delete ; input: @r5 first filename, .asciz ; 2(r5) second filename, .asciz ; 4(r5) if ge 0, print a log of files renamed delete::save <r2,r3,r4> ; save these please clr r4 ; no files renamed as of yet mov #renlst ,r3 ; where to build the .rename list mov @r5 ,r0 ; string address call docsi ; do the first one bcs 100$ ; oops mov #renlst ,r1 ; check for wildcarding mov #4 ,r2 ; four words to check for wildcards 10$: cmp (r1)+ ,#star ; a wildcard today ? beq 80$ ; yes, die sob r2 ,10$ ; no, check the next one please mov renlst ,r0 ; get the device name call devload ; get device loaded if need be bcs 100$ ; it did not work .delete #rtwork,#lun.in,#renlst ; do the delete please bcs 90$ ; oops call 200$ ; log it please mov #1 ,r4 ; one file renamed clr r0 ; no errors br 100$ ; and exit 80$: mov #er$wld ,r0 ; no wildcarding today br 100$ ; exit 90$: movb @#errbyt,r0 ; map the .rename error asl r0 ; times 2 as always mov renerr(r0),r0 ; simple 100$: mov r4 ,r1 ; return rename count beq 120$ ; never got any files, exit cmp r0 ,#er$nmf ; no more files error? beq 110$ ; yes, say no errors cmp r0 ,#er$fnf ; same goes for file not found bne 120$ ; exit 110$: clr r0 ; no errors 120$: unsave <r4,r3,r2> ; pop these and exit return 200$: tst 2(r5) ; print a log of this out bmi 210$ ; nothing to do print @r5 ; no wildcarding simplifies things print #290$ ; more 210$: return 290$: .asciz / deleted/<cr><lf> .even .sbttl parse device and filename ; parse the filename(s) ; ; input: r0 address of filename ; r3 pointer to result of parse docsi: save <r1,r2> sub #40.*2 ,sp ; allocate a local filename buffer mov sp ,r1 ; and a pointer to it please mov r0 ,r2 ; check for a ':' in the string scan #': ,r2 ; if there is no colon then insert tst r0 ; the defdir please bne 310$ ; we found a colon in the string mov #defdir ,r0 ; no device was in the string so put 305$: movb (r0)+ ,(r1)+ ; in bne 305$ ; next please dec r1 ; backup to the null we just copied 310$: movb (r2)+ ,(r1)+ ; copy it to the csi buffer bne 310$ ; until a null byte is found. movb #'= ,-1(r1) ; fake an output filespec here clrb @r1 ; and .asciz mov sp ,r1 ; reset pointer (also saving sp) .csispc r1,#defext,r1 ; and try to parse the name mov r1 ,sp ; restore from any switches bcs 320$ ; it's ok mov (r1)+ ,(r3)+ ; copy the device and filename mov (r1)+ ,(r3)+ ; copy the device and filename mov (r1)+ ,(r3)+ ; copy the device and filename mov (r1)+ ,(r3)+ ; copy the device and filename add #40.*2 ,sp ; restore the stack clc ; no errors br 330$ 320$: movb @#errbyt,r0 ; get the error mapping for .csispc asl r0 ; index to word offsets mov csierr(r0),r0 ; simple add #40.*2 ,sp ; restore the stack sec ; flag the error and exit 330$: unsave <r2,r1> return .sbttl get device driver loaded if need be ; DEVLOAD ; ; input: r0 device name ; output: r0 error code if carry is set devload:calls fetch ,<r0> tst r0 ; did it work ? bne 90$ ; no clc ; yes return 90$: sec ; no return ; exit .sbttl copy command copy:: save <r2,r3> ; save temp registers please clr r2 ; number of blocks = 0 mov #1000 ,r3 ; calls open ,<@r5,#lun.in,#binary> ; get the input file tst r0 ; did it work? bne 110$ ; no, simple exit then calls create ,<2(r5),#lun.out,#binary> ; create the destination tst r0 ; did it work ? bne 100$ ; no, close the input file now 10$: calls getc ,<#lun.in> ; get the next ch from the file tst r0 ; did it work ? bne 20$ ; no, check for eof condition calls putc ,<r1,#lun.ou> ; yes, copy to output file tst r0 ; did that work ? bne 20$ ; no sob r3 ,10$ ; next ch please inc r2 ; blocks := succ( blocks ) mov #1000 ,r3 ; copy the next block now br 10$ ; back for more now please 20$: cmp r0 ,#er$eof ; normal exit should be eof bne 30$ ; it's not clr r0 ; clear error codes 30$: save <r0> ; save error code calls close ,<#lun.in> ; close input file calls close ,<#lun.ou> ; close output file unsave <r0> ; restore error code and exit br 120$ ; and exit 100$: calls close ,<#lun.in> ; close input if output create failed 110$: ; 120$: mov r2 ,r1 ; return number of blocks and exit unsave <r3,r2> return .sbttl ascdat convert to ascii date for RT11 .mcall .date ; input: @r5 output buffer address ; 2(r5) value of date, zero implies current ; ; I certainly could use my ASH and DIV macros, but may as ; well do it this way for future possibilities. ascdat::save <r0,r1,r2,r3> ; save these please mov @r5 ,r1 ; the result address cmp 2(r5) ,#-1 ; if -1, then return 00-XXX-00 bne 5$ ; no copyz #310$ ,r1 ; yes, then exit br 100$ ; bye 5$: mov 2(r5) ,r0 ; get the date desired please bne 10$ ; it's ok .date ; zero, assume todays date then 10$: bic #100000 ,r0 ; undefined mov r0 ,r3 ; copy the date asr r3 ; /2 asr r3 ; /2 again asr r3 ; ditto asr r3 ; sigh asr r3 ; at last bic #^C37 ,r3 ; the date, at last call 200$ ; convert it mov r0 ,r3 ; get the date once again please swab r3 ; get the month to bits 2..7 asr r3 ; /2 asr r3 ; /2 again bic #^C17 ,r3 ; get rid of the unwanted bits now dec r3 ; convert to 0..11 asl r3 ; convert to word offset asl r3 ; quad offset add #300$ ,r3 ; the address of the text movb #'- ,(r1)+ ; copy it over please movb (r3)+ ,(r1)+ ; three characters please movb (r3)+ ,(r1)+ ; three characters please movb (r3)+ ,(r1)+ ; three characters please movb #'- ,(r1)+ ; copy it over please mov r0 ,r3 ; copy the date bic #^C37 ,r3 ; the year, at last add #110 ,r3 ; plus the bias please call 200$ ; convert clrb @r1 ; .asciz and exit 100$: unsave <r3,r2,r1,r0> return 200$: clr r2 ; subtract 10 a few times 210$: inc r2 ; high digit number sub #12 ,r3 ; until we get a negative number tst r3 ; done yet ? bge 210$ ; no dec r2 ; yes add #12 ,r3 ; correct it please add #'0 ,r2 ; and copy the day number please add #'0 ,r3 ; simple movb r2 ,(r1)+ ; copy it movb r3 ,(r1)+ ; copy it return 300$: .ascii /Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec / 310$: .asciz /00-XXX-00/ .even .sbttl get the ascii time .mcall .gtim ; input: @r5 buffer address for .asciz string asctim::save <r0,r1,r2,r3> ; save all registers that we use cmp -(sp) ,-(sp) ; allocate two word buffer mov sp ,r3 ; and point to the small buffer .gtim #rtwork ,r3 ; and get the time, ticks past midnite mov (r3)+ ,r1 ; get set to divide to get seconds mov (r3)+ ,r2 ; setup for $ddiv mov #60.*60.,r0 ; at last call ddiv ; double precision divide mov r0 ,-(sp) ; save ticks since last minute mov #60. ,r0 ; and get hours in r2, minutes in r0 call ddiv ; simple to do mov @r5 ,r1 ; buffer address please mov r2 ,r3 ; convert hours to ascii call 200$ ; simple movb #': ,(r1)+ ; a delimiter mov r0 ,r3 ; the minutes next please call 200$ ; simple movb #': ,(r1)+ ; and a delimiter please mov (sp)+ ,r2 ; now get the seconds extracted please mov r1 ,-(sp) ; save buffer pointer please clr r1 ; may as well use $ddiv mov #60. ,r0 ; simple call ddiv ; simple to do mov (sp)+ ,r1 ; restore buffer pointer mov r2 ,r3 ; and convert to ascii call 200$ ; do it clrb @r1 ; all done, make it .asciz and exit cmp (sp)+ ,(sp)+ ; pop the two word buffer unsave <r3,r2,r1,r0> ; pop registers we used and exit return 200$: clr r2 ; subtract 10 a few times 210$: inc r2 ; high digit number sub #12 ,r3 ; until we get a negative number tst r3 ; done yet ? bge 210$ ; no dec r2 ; yes add #12 ,r3 ; correct it please add #'0 ,r2 ; and copy the day number please add #'0 ,r3 ; simple movb r2 ,(r1)+ ; copy it movb r3 ,(r1)+ ; copy it return .sbttl double precision divide ; Double precision divide (from RSX syslib) ; ; input: r2 = low order of dividend ; r1 = high order of dividend ; r0 = divisor ; ; output: r2 = low order of quotient ; r1 = high order of quotient ; r0 = remainder ddiv: mov r3,-(sp) ; save r3 mov #40,r3 ; set iteration count in r3 mov r0,-(sp) ; put divisor on the stack clr r0 ; set the remainder to zero 10$: asl r2 ; shift the entire divedend rol r1 ; ... rol r0 ; ... to left and into remainder cmp r0,(sp) ; is remainder greater than divisor blo 20$ ; no, skip to iteration control sub (sp),r0 ; yes, subtract divisor out please inc r2 ; increment the quotient 20$: dec r3 ; repeat please bgt 10$ ; not done tst (sp)+ ; pop divisor mov (sp)+,r3 ; restore r3 and exit return ; bye .sbttl read a record from a sequential file ; G E T R E C ; ; getrec( %loc buffer, %val channel_number ) ; ; input: @r5 address of user buffer, at least 80 bytes ; 2(r5) channel number ; ; output: r0 rms sts ; r1 record size ; ; Read the next record from a disk file. Assumes that the ; user has supplied a buffer of 132 characters to return ; the record to. ; ; We really don't need GETREC for RT11 Kermit. It was used ; in the RMS11 version (for RSXM/M+ and RSTS) only in con- ; junction with GETC to fake RMS single character i/o. The ; only two places it is called from is for the TYPE and ; HELP commands (C$TYPE and C$HELP). ; GETREC assumes text (stream ascii) file only. .iif ndf, FF , FF = 14 .iif ndf, CR , CR = 15 .iif ndf, LF , LF = 12 getrec::save <r2,r3,r4> ; save registers we may need clr r4 ; recordsize := 0 mov @r5 ,r3 ; the recordbuffer address mov #132. ,r2 ; max size of a record to read clr r1 ; nothing read as of yet 10$: cmpb r1 ,#ff ; exit if ch = form_feed beq 30$ ; mov 2(r5) ,r0 ; the channel number to use call getcr0 ; read the next character now tst r0 ; did it work ? bne 100$ ; no cmpb r1 ,#cr ; exit if ch = carriage_return beq 30$ ; cmpb r1 ,#'z&37 ; exit if ch = control_z beq 30$ ; cmpb r1 ,#lf ; ignore line feeds beq 10$ ; inc r4 ; length := succ(length) movb r1 ,(r3)+ ; yes, stuff the character in sob r2 ,10$ ; up until maxrec size mov #er$rtb ,r0 ; too much data, return maxsize br 100$ ; error 30$: cmpb r1 ,#'z&37 ; we get here on reading a record bne 40$ ; terminator mov #er$eof ,r0 ; control z means end of file clr r1 ; no data is there at all br 100$ 40$: mov r4 ,r1 ; return the record length br 100$ ; all done if ff or lf 100$: unsave <r4,r3,r2> ; pop registers we saved return ; bye .end